Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/regcode/registry.bas

BASIC Source File | 1998-08-11 | 19.1 KB | 455 lines

Attribute VB_Name = "RegistryModule"
Option Explicit
' --------------------------------------------------------
' Module    : RegistryModule(Registry.bas)
' Written by: Elito C. Lelina III
'             ECLIPSE Development Software
' URL       : www.geocities.com/SiliconValley/Campus/3118/
' email     : [e-mail]
' --------------------------------------------------------
'
' This module contains functions for reading and
' setting registry values of type REG_SZ and REG_DWORD
' in Windows 95 and Windows NT. Code can be modified
' to handle other Value type.
'
' This program makes no guarantees and no support is provided,
' but comments/bug reports are welcome.
'
' Warning:  Windows depends heavily on Registry Data file.
' Editing registry values can seriously impact Windows and
' your machine's operations. Create Registry Backup before
' editing. You should only edit values when you know what
' they should be.  If editing values as a test, make a note
' of the original value and restore it when you are done.

' Project Registry Const
Public Const regAutoStartPath = "Software\Microsoft\Windows\CurrentVersion\Run"
Public Const regAppName = "ECLRegDemo"
Public Const regAppKeyName = "Software\ECLIPSE Development Software\" & regAppName

' --------------------------------------------------------
' FILETIME type is needed for RegEnumKey and RegQueryInfoKey
' --------------------------------------------------------
Private Type FILETIME
    lLowDateTime    As Long
    lHighDateTime   As Long
End Type

' --------------------------------------------------------
' Registry Root Keys. Most Programs would use HKEY_CURRENT_USER
' and HKEY_LOCAL_MACHINE for storing settings. If you want to
' retain settings for individual user (Machine should be configured
' for multiple users), store settings in CURRENT_USER.
' HKEY_CLASSES_ROOT contains information about Application file
' types.
' --------------------------------------------------------
Public Enum RegRootKeys
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum

' --------------------------------------------------------
' Registry Data types. This module supports only REG_SZ and
' REG_DWORD Data types. Uncomment other data type when modifying
' this module to support other types
' --------------------------------------------------------
Public Enum RegDataTypes
    REG_NONE = 0&                  ' No value type
    REG_SZ = 1&                    ' Unicode null terminated string
'    REG_EXPAND_SZ = 2&             ' Unicode null terminated string (with environment variable references)
'    REG_BINARY = 3&                ' Free form binary
    REG_DWORD = 4&                 ' 32-bit number
'    REG_DWORD_LITTLE_ENDIAN = 4&   ' 32-bit number (same as REG_DWORD)
'    REG_DWORD_BIG_ENDIAN = 5&      ' 32-bit number
'    REG_LINK = 6&                  ' Symbolic Link (unicode)
'    REG_MULTI_SZ = 7&              ' Multiple Unicode strings
'    REG_RESOURCE_LIST = 8&         ' Resource list in the resource map
'    REG_FULL_RESOURCE_DESCRIPTOR = 9&    ' Resource list in the hardware description
'    REG_RESOURCE_REQUIREMENTS_LIST = 10&
End Enum

' --------------------------------------------------------
' Return codes from Registration functions.
' --------------------------------------------------------
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_BADDB = 1009&
Private Const ERROR_BADKEY = 1010&
Private Const ERROR_CANTOPEN = 1011&
Private Const ERROR_CANTREAD = 1012&
Private Const ERROR_CANTWRITE = 1013&
Private Const ERROR_OUTOFMEMORY = 14&
Private Const ERROR_INVALID_PARAMETER = 87&
Private Const ERROR_ACCESS_DENIED = 5&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234&

' --------------------------------------------------------
' Read/Write permissions:
' --------------------------------------------------------
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const WRITE_OWNER = &H80000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Private Const KEY_EXECUTE = KEY_READ

Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
   KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
   KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

' ---------------------------
' 32-bit registry functions
' ---------------------------
Private Declare Function RegCreateKey Lib "advapi32" Alias "RegCreateKeyA" (ByVal hkey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hkey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32" Alias "RegEnumKeyA" (ByVal hkey As Long, ByVal iSubKey As Long, ByVal lpszName As String, ByVal cchName As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey&, ByVal lpszSubKey$, dwOptions&, ByVal samDesired&, lpHKey&) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, lpdwType As Long, lpbData As Any, cbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, ByVal fdwType As Long, lpbData As Any, ByVal cbData As Long) As Long
Private Declare Function RegSetStringEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, ByVal fdwType As Long, lpbData As String, ByVal cbData As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Private Declare Function RegEnumValue& Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hkey&, ByVal dwIndex&, ByVal lpName$, lpcbName&, ByVal lpReserved&, lpdwType&, lpValue As Any, lpcbValue&)
Private Declare Function RegQueryInfoKey& Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hkey&, ByVal lpClass$, lpcbClass&, ByVal lpReserved&, lpcSubKeys&, lpcbMaxSubKeyLen&, lpcbMaxClassLen&, lpcValues&, lpcbMaxValueNameLen&, lpcbMaxValueLen&, lpcbSecurityDescriptor&, lpftLastWriteTime As FILETIME)

' Registry content value holder (use in obtaining value)
Public regValue As Variant

' --------------------------------------------------------
' Purpose   : Check if a certain key exist in the registry
'             hkey = Registry Root key
'             SubKeyPath = String containing the keypath to query
' Return    : True = Function Successful
'             False = Function Failed
' Example   : result = regKeyExist(HKEY_LOCAL_MACHINE,_
'                      "Software\ECLIPSE Development Software\")
' --------------------------------------------------------
Public Function regKeyExist(hkey As RegRootKeys, SubKeyPath As String) As Boolean
Dim lresult As Long
Dim phkResult As Long
    ' Opens the requested key
    lresult = RegOpenKeyEx(hkey, SubKeyPath, ByVal 0&, KEY_ALL_ACCESS, phkResult)
    ' Returns ERROR_SUCCESS if the key exist
    If lresult = ERROR_SUCCESS Then
        regKeyExist = True
        lresult = RegCloseKey(phkResult)
    Else
        regKeyExist = False
    End If

End Function

' --------------------------------------------------------
' Purpose   : Creates new Value name in the registry
'             hkey = Registry Root key
'             SubKeyPath = String containing the keypath to create
'             regDataType = either REG_DWORD or REG_SZ
'             KeyName = String containing the key Name to create
'             KeyValue = contains value to store in the registry
' Return    : True = Function Successful
'             False = Function Failed
' Example   : result = CreateRegEntry(HKEY_LOCAL_MACHINE,_
'                      "Software\ECLIPSE Development Software\PhoneBook",_
'                       REG_SZ , "Phone Number", "[phone]")
' --------------------------------------------------------
Public Function CreateRegEntry(hkey As RegRootKeys, SubKeyPath As String, Optional KeyDatatype As RegDataTypes, Optional KeyName As String, Optional KeyValue As Variant) As Boolean
Dim lresult As Long
Dim phkResult As Long
Dim IsNewKey As Long
Dim KeyValueLng As Long
Dim KeyValueStr As String

    On Local Error GoTo CreateRegEntry_Err
    ' Set path to your application's settings.
    lresult = RegCreateKeyEx(hkey, SubKeyPath, 0&, REG_SZ, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, phkResult, IsNewKey)

    If Not (lresult = ERROR_SUCCESS) Then
        CreateRegEntry = False
        GoTo CreateRegEntry_End
    End If

    ' Determine data type and use appropriate
    ' passed value.
    If Not IsMissing(KeyDatatype) Then
        Select Case KeyDatatype
            Case REG_DWORD
                KeyValueLng = KeyValue
                lresult = RegSetValueEx(phkResult, KeyName, ByVal 0&, KeyDatatype, KeyValueLng, Len(KeyValueLng))
            Case REG_SZ
                KeyValueStr = KeyValue
                lresult = RegSetValueEx(phkResult, KeyName, ByVal 0&, KeyDatatype, ByVal KeyValueStr, Len(KeyValueStr))
        End Select

        If Not (lresult = ERROR_SUCCESS) Then
            CreateRegEntry = False
            GoTo CreateRegEntry_End
        End If
    End If
    CreateRegEntry = True

CreateRegEntry_End:
    Exit Function

CreateRegEntry_Err:
    CreateRegEntry = False
    Resume CreateRegEntry_End
End Function

' --------------------------------------------------------
' Purpose   : Deletes an entire keypath from the registry
'             (Use with extreme caution!)
'             hkey = Registry Root key
'             SubKeyPath = String containing the keypath to delete
' Return    : True = Function Successful
'             False = Function Failed
' Example   : result = DeleteregEntry(HKEY_LOCAL_MACHINE,_
'                      "Software\ECLIPSE Development Software\PhoneBook")
' --------------------------------------------------------
Public Function DeleteRegEntry(hkey As RegRootKeys, SubKeyPath As String) As Boolean
Dim lresult As Long
Dim phkResult As Long

    On Local Error GoTo DeleteRegEntry_Err

    ' Open the application's path key.
    lresult = RegOpenKeyEx(hkey, SubKeyPath, ByVal 0&, KEY_ALL_ACCESS, phkResult)
    If Not (lresult = ERROR_SUCCESS) Then
        DeleteRegEntry = False
        GoTo DeleteRegEntry_End
    End If

    ' Delete the entire application's path key and any
    ' associated keys and values.
    lresult = RegDeleteKey(hkey, SubKeyPath)

    If Not (lresult = ERROR_SUCCESS) Then
        DeleteRegEntry = False
        GoTo DeleteRegEntry_End
    End If

    lresult = RegCloseKey(hkey)
    DeleteRegEntry = True

DeleteRegEntry_End:
    Exit Function

DeleteRegEntry_Err:
    DeleteRegEntry = False
    Resume DeleteRegEntry_End
End Function

' --------------------------------------------------------
' Purpose   : Deletes a key value rom the registry
'             hkey = Registry Root key
'             SubKeyPath = String containing the keypath to delete
'             KeyName = String containing the key Name to delete
' Return    : True = Function Successful
'             False = Function Failed
' Example   : result = DeleteRegValue(HKEY_LOCAL_MACHINE,_
'                      "Software\ECLIPSE Development Software\PhoneBook",_
'                       "Phone Number")
' --------------------------------------------------------
Public Function DeleteRegValue(hkey As RegRootKeys, SubKeyPath As String, KeyName As String) As Boolean
Dim lresult As Long
Dim phkResult As Long

    On Local Error GoTo DeleteRegValue_Err

    ' Open the application's path key.
    lresult = RegOpenKeyEx(hkey, SubKeyPath, ByVal 0&, KEY_ALL_ACCESS, phkResult)

    If Not (lresult = ERROR_SUCCESS) Then
        DeleteRegValue = False
        GoTo DeleteRegValue_End
    End If

    lresult = RegDeleteValue(phkResult, KeyName)
    If lresult = ERROR_SUCCESS Then
        DeleteRegValue = True
    Else
        DeleteRegValue = False
    End If
    lresult = RegCloseKey(phkResult)

DeleteRegValue_End:
    Exit Function

DeleteRegValue_Err:
    DeleteRegValue = False
    Resume DeleteRegValue_End
End Function

' --------------------------------------------------------
' Purpose   : Query an exisitng Value name in the registry
'             hkey = Registry Root key
'             SubKeyPath = String containing the keypath to query
'             KeyName = String containing the key Name to query
'             regDataType = either REG_DWORD or REG_SZ
'             KeyValue = contains the result value that was queried
'                        This will hold the same value as the RegValue
'             DefaultValue = (optional) the value to return when the requested
'                            key doesn't exist.
' Return    : True = Function Successful
'             False = Function Failed
' Example   : result = GetRegValue(HKEY_LOCAL_MACHINE,_
'                      "Software\ECLIPSE Development Software\PhoneBook",_
'                       "Phone Number", REG_SZ , strPhNum, "[phone]")
' --------------------------------------------------------

Public Function GetRegValue(hkey As RegRootKeys, SubKeyPath As String, KeyName As String, KeyDatatype As RegDataTypes, KeyValue As Variant, Optional DefaultValue) As Boolean
Dim lresult As Long
Dim phkResult As Long
Dim dwType As Long
Dim cbData As Long
Dim varStrData As String
Dim varLngData As Long

    On Local Error GoTo GetRegValue_Err
    regValue = ""   'clear previous value first

    ' Open the key for application's path.
    lresult = RegOpenKeyEx(hkey, SubKeyPath, ByVal 0&, KEY_ALL_ACCESS, phkResult)
    If Not (lresult = ERROR_SUCCESS) Then
        GetRegValue = False
        GoTo GetRegValue_End
    End If

   ' Set up passed variables and retrieve value.
    Select Case KeyDatatype
        Case REG_SZ
            varStrData = String$(255, 0)
            cbData = LenB(varStrData)
            lresult = RegQueryValueEx(phkResult, KeyName, ByVal 0&, dwType, ByVal varStrData, cbData)
        Case REG_DWORD
            varLngData = False
            cbData = LenB(varLngData)
            lresult = RegQueryValueEx(phkResult, KeyName, ByVal 0&, dwType, varLngData, cbData)
    End Select

    If Not (lresult = ERROR_SUCCESS) Then
        GetRegValue = False
        GoTo GetRegValue_End
    End If

    ' Select data type (for the needed types
    ' used in the values) and assign value.
    Select Case dwType
        Case REG_NONE
            KeyValue = ""
        Case REG_SZ
            KeyValue = Left$(varStrData, cbData)
        Case REG_DWORD
            KeyValue = varLngData
        Case Else
            KeyValue = ""
    End Select

    GetRegValue = True
    regValue = KeyValue

    ' Close key.
    lresult = RegCloseKey(phkResult)

GetRegValue_End:
    If Not IsMissing(DefaultValue) And GetRegValue = False Then
        regValue = DefaultValue
    End If
    Exit Function

GetRegValue_Err:
   Resume GetRegValue_End
End Function

' --------------------------------------------------------
' Purpose   : Stores a key Value into an existing name in the registry
'             If the key doesn't exist, it will be created first.
'             hkey = Registry Root key
'             SubKeyPath = String containing the keypath
'             KeyName = String containing the key Name to store the value
'             regDataType = either REG_DWORD or REG_SZ
'             NewKeyValue = contains new value to store in the registry
' Return    : True = Function Successful
'             False = Function Failed
' Example   : result = SetRegValue(HKEY_LOCAL_MACHINE,_
'                      "Software\ECLIPSE Development Software\PhoneBook",_
'                       "Phone Number", REG_SZ , "[phone]")
' --------------------------------------------------------

Public Function SetRegValue(hkey As RegRootKeys, SubKeyPath As String, KeyName As String, KeyDatatype As RegDataTypes, NewKeyValue As Variant) As Boolean
Dim lresult As Long
Dim phkResult As Long
Dim dwType As Long
Dim cbData As Long
Dim varStrData As String
Dim varLngData As Long
'Dim Msg As String
    On Local Error GoTo SetRegValue_Err

    ' Open the key for application's path.
    lresult = RegOpenKeyEx(hkey, SubKeyPath, ByVal 0&, KEY_ALL_ACCESS, phkResult)
    If Not (lresult = ERROR_SUCCESS) Then
        ' the key may not yet exist, try to create new key
        CreateRegEntry hkey, SubKeyPath, CLng(KeyDatatype), KeyName, NewKeyValue
        ' Try to reopen the key the second time
        lresult = RegOpenKeyEx(hkey, SubKeyPath, ByVal 0&, KEY_ALL_ACCESS, phkResult)
        If Not (lresult = ERROR_SUCCESS) Then
            SetRegValue = False
            GoTo SetRegValue_End
        End If
    End If

    ' Set up passed variables and retrieve value.
    Select Case KeyDatatype
        Case REG_SZ
            varStrData = NewKeyValue
            lresult = RegSetValueEx(phkResult, KeyName, ByVal 0&, KeyDatatype, ByVal varStrData, Len(varStrData))
        Case REG_DWORD
            varLngData = CLng(NewKeyValue)
            lresult = RegSetValueEx(phkResult, KeyName, ByVal 0&, KeyDatatype, varLngData, Len(varLngData))
    End Select

    If Not (lresult = ERROR_SUCCESS) Then
        SetRegValue = False
        GoTo SetRegValue_End
    End If

    ' Close key.
    lresult = RegCloseKey(phkResult)
    SetRegValue = True

SetRegValue_End:
    Exit Function

SetRegValue_Err:
    Resume SetRegValue_End
End Function